home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / AskX / AskX.p
Encoding:
Text File  |  1997-05-06  |  3.2 KB  |  127 lines
  1. {
  2.   +---------------------------------------------------------------------+
  3.   |                                    |
  4.   |      AskX - (C) 1993 by "Diesel" B. Künnen, written 4 my special    |
  5.   |      friend Invisible Power - hi Jürgen, die InfoX wird immer    |
  6.   |      besser !   C U !                        |
  7.   |                                    |
  8.   |      AskX ist ein Ersatz für C=`s ask-Befehl. Er bietet genau wie   |
  9.   |      das ARP-Ask eine Otpion zur Auszeit, d.h. es wartet nur eine   |
  10.   |      vom User definierte Zeit auf einen Tastendruck. [ ARP läuft    |
  11.   |      ja leider unter OS 2.0 nicht einwandfrei. ]            |
  12.   |                                    |
  13.   +---------------------------------------------------------------------+
  14. }
  15.  
  16. Program AskX;
  17.  
  18. {$I "Include:utils/Parameters.i"}
  19. {$I "Include:utils/stringlib.i"}
  20. {$I "Include:libraries/dos.i"}
  21.  
  22. Const
  23.     loop : Short = 0;
  24.  
  25. Var
  26.     buf1,
  27.     buf2,
  28.     buf3  : String;
  29.     hdl   : FileHandle;
  30.     max,
  31.     len,
  32.     val,
  33.     ten,
  34.     i    : Integer;
  35.  
  36.  
  37. Function Taste : Boolean;        { Überpfüfen, ob Taste gedrückt }
  38. Begin
  39.  
  40.                         { buf 2 konvertieren }
  41.     for i := 0 to strlen( buf2 )-1 do
  42.         buf2[i] := toupper( buf2[i] );
  43.                         { = TIMEOUT ? }
  44.     if strcmp( buf2, "TIMEOUT" )=0 then begin
  45.  
  46. { buf 3 }
  47.       max := strlen( buf3 );        { Anzahl Ziffern }
  48.       If max>5 then max :=5;        { max. 99999     }
  49.       ten :=  1;
  50.       val :=  0;
  51.                         { Ziffer -> Integer }
  52.       for i := max-1 downto 0 do Begin
  53.         If IsDigit( buf3[i] ) then Begin
  54.         val := val + ( Byte(buf3[i]) - Byte('0') ) * ten;
  55.         ten := ten * 10
  56.         End Else  i := 0;            { Ziffer für Ziffer }
  57.       End;
  58.  
  59.      hdl := DosOutput;            { Testen, ob überhaupt    }
  60.       If IsInterActive( hdl ) then Begin    { CLI-Fenster & keine    }
  61.         If WaitForChar( hdl, val*1000000)    { Datei, ggf. warten    }
  62.         Then Taste := True            { Taste -> OK        }
  63.         Else Taste := False;        { Keine Taste -> KO    }
  64.       End;
  65.     End;
  66.     Taste:=True;
  67. End;
  68.  
  69.  
  70.  
  71.  
  72.  
  73. Begin
  74.     buf1 := AllocString( 100 );    { Puffer für die Strings holen }
  75.     buf2 := AllocString( 100 );
  76.     buf3 := AllocString( 100 );
  77.  
  78.     GetParam(1, buf1);        { CLI-Parameter holen,    }
  79.     GetParam(2, buf2);        { Sofern vorhanden    }
  80.     GetParam(3, buf3);
  81.                     { Wenn keine Parameter: }
  82.     If strlen(buf1)=0 then Begin
  83.       writeln("\nAskX 1.0, (C)1993 by Diesel\nUsage : AskX AskString [ timeout secs ]\ny/Y -> OK, n/N -> WARN\n\n");
  84.       Exit(0);
  85.     End;
  86.  
  87. { buf 1 }
  88.  
  89.     If buf1[1]='"' then Begin    { Wenn der Ask-String in }
  90.                     { Anf.Zeichen steht, muß }
  91.                     { das Ende gesucht werden}
  92.       i := 2;
  93.       len := strlen(buf1);
  94.  
  95.       while  i< len do Begin
  96.         if buf1[i] = '"' then Begin { Wenn Ende gefunden, als }
  97.            buf1[i] := chr(0);    { solches mit 0-Byte      }
  98.            i := len;        { terminieren          }
  99.         End;
  100.       End;
  101.     End;
  102.  
  103.     Repeat
  104.       inc(loop);            { Schleifenzähler   }
  105.       Write( buf1 );        { Ask-String setzen }
  106.  
  107.       IF  (loop=1)            { Nur beim 1. Durchgang  }
  108.       AND (strlen(buf2)>0)        { ggf. die Zeit abwarten }
  109.       AND (strlen(buf3)>0)
  110.       THEN BEGIN
  111.         If Not Taste then Begin    { -Taste- wartet die angegebene   }
  112.           Writeln;            { Zeit auf eine Meldung des Users }
  113.           Exit(0);            { Nix ? Dann Exit(0)          }
  114.         End;
  115.       END;
  116.  
  117.       Readln(buf2);            { buf2 kann jetzt zum Einlesen      }
  118.       buf2[0]:=toUpper(buf2[0]);    { verwendet werden : y oder n ?      }
  119.     until (buf2[0]='Y') OR (buf2[0]='N');    { Bis y oder n !!!!      }
  120.  
  121.     If    buf2[0] = 'Y'
  122.     then  Exit(0)        { Y }
  123.     else  Exit(5);        { N }
  124.  
  125. End.
  126.  
  127.